prep

load packages

library(tidyverse)
library(lme4)
library(lmerTest)
library(knitr)
library(cowplot)
library(caret)
library(ROCR)

define aesthetics

algorithm = c("#006989", "#FEC601", "#F43C13", "#00A5CF", "#00A878")
instruction = wesanderson::wes_palette("Darjeeling1", 2, "continuous")
craving = wesanderson::wes_palette("Darjeeling1", 3, "continuous")
rating = c("#00A08A", "#F2AD00", "#F98400", "#FF0000")
dc_bw = plot_aes = theme_minimal() +
  theme(legend.position = "top",
        legend.text = element_text(size = 12),
        text = element_text(size = 16, family = "Futura Medium"),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        axis.text = element_text(color = "black"),
        axis.line = element_line(colour = "black"),
        axis.ticks.y = element_blank())

define functions

table_model = function(model_data) {
  model_data %>%
    broom.mixed::tidy(., conf.int = TRUE) %>%
    rename("SE" = std.error,
           "t" = statistic,
           "p" = p.value) %>%
    filter(effect == "fixed") %>%
    select(-group, -effect) %>%
    mutate_at(vars(-contains("term"), -contains("value")), round, 2) %>%
    mutate(term = gsub(":", " x ", term),
           term = gsub("dot_", "", term),
           term = gsub("wave2", " wave (post)", term),
           term = gsub("instructionregulate", "instruction (regulate)", term),
           p = ifelse(p < .001, "< .001",
                      ifelse(p == 1, "1.000", gsub("0.(.*)", ".\\1", sprintf("%.3f", p)))),
           `b [95% CI]` = sprintf("%.2f [%0.2f, %.2f]", estimate, conf.low, conf.high)) %>%
    select(term, `b [95% CI]`, df, t, p) %>%
    kable()
}

load tidied data

source("load_data.R")

check ratings

Check if wrong buttons were used (i.e., not 5-8)

  • DEV001 = code normally
  • DEV011 = code normally
  • DEV016 = code normally
  • DEV017 = exclude; can’t tell if they’re missed ratings or incorrect placement of fingers
  • DEV019 = exclude; can’t tell if they’re missed ratings or incorrect placement of fingers
  • DEV020 = code normally
  • DEV022 = code normally
  • DEV028 = code normally
  • DEV032 = incorrect placement of fingers; recode runs 1-2 (LOOK INTO WTP)
  • DEV037 = exclude; technical error?
  • DEV054 = exclude; technical error?
  • DEV060 = code normally; task ended early
  • DEV061 = code normally; task ended early
  • DEV063 = code normally; task ended early
  • DEV069 = incorrect placement of fingers in run1
  • DEV075 = code normally
  • DEV082 = code normally
  • DEV083 = code normally

NB! NEED TO GO THROUGH NEW PARTICPANTS/WAVES

subs = data.all %>%
  group_by(subjectID, wave, run, rating) %>%
  summarize(n = n()) %>%
  spread(rating, n) %>%
  mutate(messed = ifelse(is.na(`5`) & !is.na(`<NA>`), "yes", NA)) %>%
  filter(messed == "yes") %>% 
  ungroup() %>% 
  select(subjectID, wave) %>% 
  unique()

data.all %>%
  group_by(subjectID, run, rating) %>%
  summarize(n = n()) %>%
  spread(rating, n) %>%
  mutate(messed = ifelse(is.na(`5`) & !is.na(`<NA>`), "yes", NA)) %>%
  filter(subjectID %in% subs$subjectID)

recode and exclude

Recoding
* DEV069: recode runs1

NB! NEED TO GO THROUGH NEW PARTICPANTS/WAVES

data.ex = data.all %>%
  mutate(rating = ifelse(subjectID == "DEV069" & run == "run1", rating - 1, rating),
         rating = ifelse(subjectID == "DEV069" & run == "run1" & is.na(rating), 8, rating),
         rating = rating - 4) %>%
  group_by(subjectID, wave) %>%
  arrange(subjectID, run) %>%
  mutate(trial = row_number())

load mean intensity values

file_dir = "~/Documents/code/sanlab/DEV_scripts/fMRI/betaseries/ROC/dotProducts_ROC_wave1/"
file_pattern = "DEV[0-9]{3}_meanIntensity.txt"
file_list = list.files(file_dir, pattern = file_pattern)

intensities = data.frame()

for (file in file_list) {
  temp = tryCatch(read.table(file.path(file_dir,file), fill = TRUE) %>%
                    rename("subjectID" = V1,
                           "meanIntensity" = V3) %>%
                    extract(V2, "beta", "beta_([0-9]{4}).nii") %>%
                    mutate(beta = as.integer(beta),
                           wave = 1), error = function(e) message(file))
  intensities = rbind(intensities, temp)
  rm(temp)
}

file_dir = "~/Documents/code/sanlab/DEV_scripts/fMRI/betaseries/ROC/dotProducts_ROC_wave2/"
file_list = list.files(file_dir, pattern = file_pattern)
for (file in file_list) {
  temp = tryCatch(read.table(file.path(file_dir,file), fill = TRUE) %>%
                    rename("subjectID" = V1,
                           "meanIntensity" = V3) %>%
                    extract(V2, "beta", "beta_([0-9]{4}).nii") %>%
                    mutate(beta = as.integer(beta),
                           wave = 2), error = function(e) message(file))
  intensities = rbind(intensities, temp)
  rm(temp)
}

load dot products

file_dir = "~/Documents/code/sanlab/DEV_scripts/fMRI/betaseries/ROC/dotProducts_ROC_wave1/"
file_pattern = "DEV[0-9]{3}_dotProducts.txt"
file_list = list.files(file_dir, pattern = file_pattern)

dots = data.frame()

for (file in file_list) {
  temp = tryCatch(read.table(file.path(file_dir,file), fill = TRUE) %>%
                    rename("subjectID" = V1,
                           "map" = V3,
                           "dotProduct" = V4) %>%
                    extract(V2, "beta", "beta_([0-9]{4}).nii") %>%
                    extract(map, "algorithm", "(.*)_.*.nii") %>%
                    mutate(beta = as.integer(beta),
                            wave = 1), error = function(e) message(file))
  dots = rbind(dots, temp)
  rm(temp)
}

file_dir = "~/Documents/code/sanlab/DEV_scripts/fMRI/betaseries/ROC/dotProducts_ROC_wave2/"
file_list = list.files(file_dir, pattern = file_pattern)

for (file in file_list) {
  temp = tryCatch(read.table(file.path(file_dir,file), fill = TRUE) %>%
                    rename("subjectID" = V1,
                           "map" = V3,
                           "dotProduct" = V4) %>%
                    extract(V2, "beta", "beta_([0-9]{4}).nii") %>%
                    extract(map, "algorithm", "(.*)_.*.nii") %>%
                    mutate(beta = as.integer(beta),
                            wave = 2), error = function(e) message(file))
  dots = rbind(dots, temp)
  rm(temp)
}

join intensities and dots

  • recode trials with extreme intensities as NA
dots.merged = dots %>%
  left_join(., intensities, by = c("subjectID", "wave", "beta")) %>%
  group_by(subjectID, wave, algorithm) %>%
  mutate(rownum = row_number())

# plot original
dots.merged %>%
  filter(algorithm == "craving_regulation") %>%
  ggplot(aes(1, meanIntensity)) +
    geom_boxplot()

# assess extreme values and exclude when calculating SDs
dots.merged %>%
  filter(algorithm == "craving_regulation") %>%
  arrange(meanIntensity)
dots.merged %>%
  filter(algorithm == "craving_regulation") %>%
  arrange(-meanIntensity)
# recode outliers as NA
dots.merged = dots.merged %>%
  ungroup() %>%
  mutate(meanIntensity = ifelse(meanIntensity > 1 | meanIntensity < -1, NA, meanIntensity),
         median = median(meanIntensity, na.rm = TRUE),
         sd3 = 3*sd(meanIntensity, na.rm = TRUE),
         outlier = ifelse(meanIntensity > median + sd3 | meanIntensity < median - sd3, "yes", "no"),
         dotProduct = ifelse(outlier == "yes", NA, dotProduct))
  
# plot after
dots.merged %>%
  filter(algorithm == "craving_regulation") %>%
  ggplot(aes(1, meanIntensity)) +
    geom_boxplot()

recode subs

  • DEV022 = run4 has 8 trials
  • DEV037 = ???
  • DEV048 = run4 missing
  • DEV060 = run1 has 19 trials; couldn’t estimate run1 trial 19, run3 trial 20
  • DEV061 = run3 has 19 trials; couldn’t estimate run3 trial 19
  • DEV063 = run2 has 11 trials
  • DEV081 = run2 missing (run1 was run twice)
  • DEV082 = run2 has 15 trials; couldn’t estimate run1 trial 19, run1 trial 20

NB! NEED TO GO THROUGH NEW PARTICPANTS/WAVES

trial.numbers = data.frame(subjectID = c(rep("DEV060", 79), rep("DEV061", 79), rep("DEV063", 71), rep("DEV081", 80), rep("DEV082", 75)),
                           wave = 1,
                           rownum = c(1:79, 1:79, 1:71, 1:80, 1:75),
                           trial = c(1:19, 21:80, 1:59, 61:80, 1:31, 41:80, 1:20, 41:80, 21:40, 1:35, 41:80))

dots.check = dots.merged %>%
  group_by(subjectID, wave, algorithm) %>%
  mutate(rownum = row_number()) %>%
  left_join(., trial.numbers, by = c("subjectID", "wave", "rownum")) %>%
  mutate(trial = ifelse(is.na(trial), rownum, trial),
         dotProduct = ifelse(subjectID == "DEV060" & wave == 1 & trial %in% 19:20, NA,
                      ifelse(subjectID == "DEV061" & wave == 1 & trial == 59, NA,
                      ifelse(subjectID == "DEV082" & wave == 1 & trial %in% 19:20, NA, dotProduct)))) %>%
  select(-rownum) #%>%
  #left_join(., striping, by = c("subjectID", "beta")) %>%
  #mutate(dotProduct = ifelse(!is.na(striping), NA, dotProduct))

merge data and exclude subs

Exclusions

  • MRI motion and data quality exclusions: DEV001, DEV020, DEV032, DEV047, DEV055, DEV064, DEV066
  • Button box exclusions: DEV017, DEV019, DEV037, DEV054
  • Run exclusions: DEV029 (run3), DEV037 (run1), DEV042 (run4), DEV067 (run4)

Other
* select only craved trials

NB! NEED TO GO THROUGH NEW PARTICPANTS/WAVES

data_all = left_join(dots.check, data.ex, by = c("subjectID", "wave", "trial")) %>%
  filter(!(subjectID %in% c("DEV001","DEV020","DEV032","DEV047","DEV055","DEV064","DEV066", "DEV017", "DEV019", "DEV037", "DEV054") & wave == 1)) %>%
  filter(!(subjectID == "DEV029" & wave == 1 & run == "run3") & !(subjectID == "DEV037" & wave == 1 & run == "run1") & !(subjectID == "DEV042" & wave == 1 & run == "run4") & !(subjectID == "DEV067" & wave == 1 & run == "run4")) %>%
  ungroup() %>%
  mutate(algorithm = gsub("_signature", "", algorithm),
         wave = as.character(wave))

data = data_all %>%
  filter(craving == "craved")

summarize

n participants by wave

data %>%
  select(subjectID, wave) %>%
  unique() %>%
  group_by(wave) %>%
  summarize(n = n())

n trials

data %>%
  filter(algorithm == "craving_regulation") %>%
  group_by(subjectID) %>%
  summarize(n = n()) %>%
  arrange(n)

roc

craving regulation signature

# roc curve
perf.df = data %>%
  filter(algorithm == "craving_regulation") %>%
  filter(!is.na(dotProduct) & !is.na(craving)) %>%
  mutate(instruction = ifelse(instruction == "regulate", 1, 0)) %>%
  group_by(wave) %>%
  do({
    wave = .$wave
    pred = prediction(.$dotProduct, .$instruction, label.ordering = NULL)
    perf = performance(pred, measure = "tpr", x.measure = "fpr")
    data.frame(cut=perf@alpha.values[[1]],fpr=perf@x.values[[1]],tpr=perf@y.values[[1]])
  })

ggplot(perf.df, aes(fpr, tpr, color = as.factor(wave))) +
  geom_line() +
  scale_color_manual(values = algorithm) +
  xlab("false positive rate") +
  ylab("true positive rate")

roc = data %>%
  filter(algorithm == "craving_regulation") %>%
  select(subjectID, trial, instruction, rating, dotProduct) %>%
  mutate(guess.instruction = ifelse(dotProduct > 0, "regulate", "look"),
         guess.rating = ifelse(dotProduct > 0, "low", "high"),
         rating.bin = ifelse(rating >= 3, "high", "low"),
         instruction = as.factor(instruction),
         guess.instruction = as.factor(guess.instruction),
         rating.bin = as.factor(rating.bin),
         guess.rating = as.factor(guess.rating))

confusionMatrix(roc$guess.instruction, roc$instruction)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction look regulate
##   look     5536     2250
##   regulate 3509     6784
##                                                
##                Accuracy : 0.6815               
##                  95% CI : (0.6746, 0.6882)     
##     No Information Rate : 0.5003               
##     P-Value [Acc > NIR] : < 0.00000000000000022
##                                                
##                   Kappa : 0.363                
##                                                
##  Mcnemar's Test P-Value : < 0.00000000000000022
##                                                
##             Sensitivity : 0.6121               
##             Specificity : 0.7509               
##          Pos Pred Value : 0.7110               
##          Neg Pred Value : 0.6591               
##              Prevalence : 0.5003               
##          Detection Rate : 0.3062               
##    Detection Prevalence : 0.4307               
##       Balanced Accuracy : 0.6815               
##                                                
##        'Positive' Class : look                 
## 
#confusionMatrix(roc$guess.rating, roc$rating.bin)

craving signature

crave regulate v craved look

# roc curve
perf.df = data %>%
  filter(algorithm == "craving") %>%
  filter(!is.na(dotProduct) & !is.na(craving)) %>%
  mutate(instruction = ifelse(instruction == "regulate", 1, 0)) %>%
  group_by(wave) %>%
  do({
    wave = .$wave
    pred = prediction(.$dotProduct, .$instruction, label.ordering = NULL)
    perf = performance(pred, measure = "tpr", x.measure = "fpr")
    data.frame(cut=perf@alpha.values[[1]],fpr=perf@x.values[[1]],tpr=perf@y.values[[1]])
  })

ggplot(perf.df, aes(fpr, tpr, color = as.factor(wave))) +
  geom_line() +
  scale_color_manual(values = algorithm) +
  xlab("false positive rate") +
  ylab("true positive rate")

roc = data %>%
  filter(algorithm == "craving") %>%
  select(subjectID, trial, instruction, rating, dotProduct) %>%
  mutate(guess.instruction = ifelse(dotProduct > 0, "regulate", "look"),
         guess.rating = ifelse(dotProduct > 0, "low", "high"),
         rating.bin = ifelse(rating >= 3, "high", "low"),
         instruction = as.factor(instruction),
         guess.instruction = as.factor(guess.instruction),
         rating.bin = as.factor(rating.bin),
         guess.rating = as.factor(guess.rating))

confusionMatrix(roc$guess.instruction, roc$instruction)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction look regulate
##   look     3625     4205
##   regulate 5420     4829
##                                              
##                Accuracy : 0.4676             
##                  95% CI : (0.4603, 0.4749)   
##     No Information Rate : 0.5003             
##     P-Value [Acc > NIR] : 1                  
##                                              
##                   Kappa : -0.0647            
##                                              
##  Mcnemar's Test P-Value : <0.0000000000000002
##                                              
##             Sensitivity : 0.4008             
##             Specificity : 0.5345             
##          Pos Pred Value : 0.4630             
##          Neg Pred Value : 0.4712             
##              Prevalence : 0.5003             
##          Detection Rate : 0.2005             
##    Detection Prevalence : 0.4331             
##       Balanced Accuracy : 0.4677             
##                                              
##        'Positive' Class : look               
## 
#confusionMatrix(roc$guess.rating, roc$rating.bin)

craving v neutral

# roc curve
perf.df = data_all %>%
  filter(algorithm == "craving") %>%
  filter(!is.na(dotProduct)) %>%
  filter(craving %in% c("neutral", "craved")) %>%
  mutate(craving = ifelse(craving == "craved", 1, 0)) %>%
  group_by(wave) %>%
  do({
    wave = .$wave
    pred = prediction(.$dotProduct, .$craving, label.ordering = NULL)
    perf = performance(pred, measure = "tpr", x.measure = "fpr")
    data.frame(cut=perf@alpha.values[[1]],fpr=perf@x.values[[1]],tpr=perf@y.values[[1]])
  })

ggplot(perf.df, aes(fpr, tpr, color = as.factor(wave))) +
  geom_line() +
  scale_color_manual(values = algorithm) +
  xlab("false positive rate") +
  ylab("true positive rate")

roc = data_all %>%
  filter(algorithm == "craving") %>%
  filter(craving %in% c("neutral", "craved")) %>%
  select(subjectID, trial, craving, rating, dotProduct) %>%
  mutate(guess.craving = ifelse(dotProduct > 0, "craved", "neutral"),
         guess.rating = ifelse(dotProduct > 0, "low", "high"),
         rating.bin = ifelse(rating >= 3, "high", "low"),
         craving = as.factor(craving),
         guess.craving = as.factor(guess.craving),
         rating.bin = as.factor(rating.bin),
         guess.rating = as.factor(guess.rating))

confusionMatrix(roc$guess.craving, roc$craving)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction craved neutral
##    craved   10249    3960
##    neutral   7830    5095
##                                              
##                Accuracy : 0.5655             
##                  95% CI : (0.5596, 0.5714)   
##     No Information Rate : 0.6663             
##     P-Value [Acc > NIR] : 1                  
##                                              
##                   Kappa : 0.1171             
##                                              
##  Mcnemar's Test P-Value : <0.0000000000000002
##                                              
##             Sensitivity : 0.5669             
##             Specificity : 0.5627             
##          Pos Pred Value : 0.7213             
##          Neg Pred Value : 0.3942             
##              Prevalence : 0.6663             
##          Detection Rate : 0.3777             
##    Detection Prevalence : 0.5237             
##       Balanced Accuracy : 0.5648             
##                                              
##        'Positive' Class : craved             
## 
#confusionMatrix(roc$guess.rating, roc$rating.bin)

Koban craving signature

crave regulate v craved look

# roc curve
perf.df = data %>%
  filter(algorithm == "nsc_koban") %>%
  filter(!is.na(dotProduct) & !is.na(craving)) %>%
  mutate(instruction = ifelse(instruction == "regulate", 1, 0)) %>%
  group_by(wave) %>%
  do({
    wave = .$wave
    pred = prediction(.$dotProduct, .$instruction, label.ordering = NULL)
    perf = performance(pred, measure = "tpr", x.measure = "fpr")
    data.frame(cut=perf@alpha.values[[1]],fpr=perf@x.values[[1]],tpr=perf@y.values[[1]])
  })

ggplot(perf.df, aes(fpr, tpr, color = as.factor(wave))) +
  geom_line() +
  scale_color_manual(values = algorithm) +
  xlab("false positive rate") +
  ylab("true positive rate")

roc = data %>%
  filter(algorithm == "nsc_koban") %>%
  select(subjectID, trial, instruction, rating, dotProduct) %>%
  mutate(guess.instruction = ifelse(dotProduct > 0, "regulate", "look"),
         guess.rating = ifelse(dotProduct > 0, "low", "high"),
         rating.bin = ifelse(rating >= 3, "high", "low"),
         instruction = as.factor(instruction),
         guess.instruction = as.factor(guess.instruction),
         rating.bin = as.factor(rating.bin),
         guess.rating = as.factor(guess.rating))

confusionMatrix(roc$guess.instruction, roc$instruction)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction look regulate
##   look     3714     4402
##   regulate 5331     4632
##                                              
##                Accuracy : 0.4616             
##                  95% CI : (0.4544, 0.4689)   
##     No Information Rate : 0.5003             
##     P-Value [Acc > NIR] : 1                  
##                                              
##                   Kappa : -0.0767            
##                                              
##  Mcnemar's Test P-Value : <0.0000000000000002
##                                              
##             Sensitivity : 0.4106             
##             Specificity : 0.5127             
##          Pos Pred Value : 0.4576             
##          Neg Pred Value : 0.4649             
##              Prevalence : 0.5003             
##          Detection Rate : 0.2054             
##    Detection Prevalence : 0.4489             
##       Balanced Accuracy : 0.4617             
##                                              
##        'Positive' Class : look               
## 
#confusionMatrix(roc$guess.rating, roc$rating.bin)

craving v neutral

# roc curve
perf.df = data_all %>%
  filter(algorithm == "nsc_koban") %>%
  filter(!is.na(dotProduct)) %>%
  filter(craving %in% c("neutral", "craved")) %>%
  mutate(craving = ifelse(craving == "craved", 1, 0)) %>%
  group_by(wave) %>%
  do({
    wave = .$wave
    pred = prediction(.$dotProduct, .$craving, label.ordering = NULL)
    perf = performance(pred, measure = "tpr", x.measure = "fpr")
    data.frame(cut=perf@alpha.values[[1]],fpr=perf@x.values[[1]],tpr=perf@y.values[[1]])
  })

ggplot(perf.df, aes(fpr, tpr, color = as.factor(wave))) +
  geom_line() +
  scale_color_manual(values = algorithm) +
  xlab("false positive rate") +
  ylab("true positive rate")

roc = data_all %>%
  filter(algorithm == "nsc_koban") %>%
  filter(craving %in% c("neutral", "craved")) %>%
  select(subjectID, trial, craving, rating, dotProduct) %>%
  mutate(guess.craving = ifelse(dotProduct > 0, "craved", "neutral"),
         guess.rating = ifelse(dotProduct > 0, "low", "high"),
         rating.bin = ifelse(rating >= 3, "high", "low"),
         craving = as.factor(craving),
         guess.craving = as.factor(guess.craving),
         rating.bin = as.factor(rating.bin),
         guess.rating = as.factor(guess.rating))

confusionMatrix(roc$guess.craving, roc$craving)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction craved neutral
##    craved    9963    5327
##    neutral   8116    3728
##                                              
##                Accuracy : 0.5046             
##                  95% CI : (0.4986, 0.5105)   
##     No Information Rate : 0.6663             
##     P-Value [Acc > NIR] : 1                  
##                                              
##                   Kappa : -0.0346            
##                                              
##  Mcnemar's Test P-Value : <0.0000000000000002
##                                              
##             Sensitivity : 0.5511             
##             Specificity : 0.4117             
##          Pos Pred Value : 0.6516             
##          Neg Pred Value : 0.3148             
##              Prevalence : 0.6663             
##          Detection Rate : 0.3672             
##    Detection Prevalence : 0.5635             
##       Balanced Accuracy : 0.4814             
##                                              
##        'Positive' Class : craved             
## 
#confusionMatrix(roc$guess.rating, roc$rating.bin)

correlations among signatures

craving & Koban craving

data %>%
  select(subjectID, wave, trial, algorithm, dotProduct) %>%
  spread(algorithm, dotProduct) %>%
  mutate(sub_wave = sprintf("%s_%s", subjectID, wave)) %>%
  rmcorr::rmcorr(as.factor(sub_wave), craving, nsc_koban, data = .)
## 
## Repeated measures correlation
## 
## r
## -0.06365789
## 
## degrees of freedom
## 17616
## 
## p-value
## 0.00000000000000002732407
## 
## 95% confidence interval
## -0.0783515 -0.04893664

craving & craving regulation

data %>%
  select(subjectID, wave, trial, algorithm, dotProduct) %>%
  spread(algorithm, dotProduct) %>%
  mutate(sub_wave = sprintf("%s_%s", subjectID, wave)) %>%
  rmcorr::rmcorr(as.factor(sub_wave), craving, craving_regulation, data = .)
## 
## Repeated measures correlation
## 
## r
## 0.004821728
## 
## degrees of freedom
## 17616
## 
## p-value
## 0.5221987
## 
## 95% confidence interval
## -0.009946238 0.01958759

Koban craving & craving regulation

data %>%
  select(subjectID, wave, trial, algorithm, dotProduct) %>%
  spread(algorithm, dotProduct) %>%
  mutate(sub_wave = sprintf("%s_%s", subjectID, wave)) %>%
  rmcorr::rmcorr(as.factor(sub_wave), nsc_koban, craving_regulation, data = .)
## 
## Repeated measures correlation
## 
## r
## -0.09404847
## 
## degrees of freedom
## 17616
## 
## p-value
## 0.000000000000000000000000000000000006568547
## 
## 95% confidence interval
## -0.1086648 -0.07939147

visualize raw data

instruction

across waves

data %>%
  filter(!is.na(rating)) %>%
  ggplot(aes(algorithm, dotProduct, fill = instruction)) +
    stat_summary(fun.y = mean, geom = "bar", position = position_dodge(width = 0.95)) +
    stat_summary(fun.data = mean_cl_boot, geom = "errorbar", position = position_dodge(width = 0.95), width = 0) +
    scale_fill_manual(name = "", values = instruction) + 
    labs(y = "pattern expression value\n", x = "") + 
    dc_bw

data %>%
  filter(!is.na(rating)) %>%
  ggplot(aes(instruction, dotProduct)) +
    stat_summary(aes(group = subjectID), fun.y = mean, geom = "line", alpha = .1, size = .5) +
    stat_summary(aes(group = 1), fun.y = mean, geom = "line", size = .75) +
    stat_summary(aes(color = instruction), fun.data = "mean_cl_boot",  geom = "pointrange", width = 0, size = .75) + 
    facet_grid(~algorithm) +
    scale_color_manual(name = "", values = instruction) + 
    labs(y = "pattern expression value\n", x = "") + 
    dc_bw

by waves

data %>%
  filter(!is.na(rating)) %>%
  ggplot(aes(instruction, dotProduct, fill = wave)) +
    stat_summary(fun.y = mean, geom = "bar", position = position_dodge(width = 0.95)) +
    stat_summary(fun.data = mean_cl_boot, geom = "errorbar", position = position_dodge(width = 0.95), width = 0) +
    facet_grid(~algorithm) +
    scale_fill_manual(name = "wave", values = algorithm) + 
    labs(y = "pattern expression value\n", x = "") + 
    dc_bw

data %>%
  filter(!is.na(rating)) %>%
  ggplot(aes(wave, dotProduct, color = instruction)) +
    stat_summary(aes(group = interaction(subjectID, instruction)), fun.y = mean, geom = "line", alpha = .1, size = .5) +
    stat_summary(aes(group = instruction), fun.y = mean, geom = "line", size = .75) +
    stat_summary(fun.data = "mean_cl_boot",  geom = "pointrange", width = 0, size = .75) + 
    facet_grid(~algorithm) +
    scale_color_manual(name = "", values = instruction) + 
    labs(y = "pattern expression value\n", x = "") + 
    dc_bw

rating

across waves

data %>%
  ggplot(aes(dotProduct, rating, color = algorithm, fill = algorithm)) +
  geom_smooth(aes(group = interaction(subjectID, algorithm)), method = "lm", se = FALSE, size = .1) +
  geom_smooth(method = "lm") +
  scale_color_manual(name = "signature", values = algorithm) + 
  scale_fill_manual(name = "signature", values = algorithm) + 
  labs(y = "craving rating\n", x = "\npattern expression value") + 
  dc_bw

by wave

data %>%
  ggplot(aes(dotProduct, rating, color = wave, fill = wave)) +
  geom_smooth(aes(group = interaction(subjectID, wave)), method = "lm", se = FALSE, size = .1) +
  geom_smooth(method = "lm") +
  facet_grid(~algorithm) +
  scale_color_manual(name = "wave", values = algorithm) + 
  scale_fill_manual(name = "wave", values = algorithm) + 
  labs(y = "craving rating\n", x = "\npattern expression value") + 
  dc_bw

rating and instruction

across waves

data %>%
  ggplot(aes(dotProduct, rating, color = instruction, fill = instruction)) +
  geom_smooth(aes(group = interaction(subjectID, instruction)), method = "lm", se = FALSE, size = .1) +
  geom_smooth(method = "lm") +
  facet_grid(~algorithm) +
  scale_color_manual(name = "instruction", values = instruction) + 
  scale_fill_manual(name = "instruction", values = instruction) + 
  labs(y = "craving rating\n", x = "\npattern expression value") + 
  dc_bw

by wave

data %>%
  ggplot(aes(dotProduct, rating, color = wave, fill = wave)) +
  geom_smooth(aes(group = interaction(subjectID, instruction, wave)), method = "lm", se = FALSE, size = .1) +
  geom_smooth(method = "lm") +
  facet_grid(instruction~algorithm) +
  scale_color_manual(name = "wave", values = algorithm) + 
  scale_fill_manual(name = "wave", values = algorithm) + 
  labs(y = "craving rating\n", x = "\npattern expression value") + 
  dc_bw

RT

craving

across waves

data %>%
  filter(!is.na(rating)) %>%
  filter(algorithm == "craving_regulation") %>%
  ggplot(aes(rating, rt, color = instruction, fill = instruction)) +
  geom_smooth(aes(group = interaction(subjectID, instruction)), method = "lm", se = FALSE, size = .1) +
  geom_smooth(method = "lm", alpha = .2) + 
  facet_grid(~algorithm) + 
  scale_color_manual(name = "", values = instruction) + 
  scale_fill_manual(name = "", values = instruction) + 
  labs(x = "\ncraving rating", y = "reaction time (seconds)\n") + 
  dc_bw

by wave

data %>%
  filter(!is.na(rating)) %>%
  filter(algorithm == "craving_regulation") %>%
  ggplot(aes(rating, rt, color = wave, fill = wave)) +
  geom_smooth(aes(group = interaction(subjectID, wave, instruction)), method = "lm", se = FALSE, size = .1) +
  geom_smooth(method = "lm", alpha = .2) + 
  facet_grid(~instruction) + 
  scale_color_manual(name = "", values = algorithm) + 
  scale_fill_manual(name = "", values = algorithm) + 
  labs(x = "\ncraving rating", y = "reaction time (seconds)\n") + 
  dc_bw

pattern expression

across waves

data %>%
  filter(!is.na(rating)) %>%
  ggplot(aes(dotProduct, rt, color = instruction, fill = instruction)) +
  geom_smooth(aes(group = interaction(subjectID, instruction)), method = "lm", se = FALSE, size = .1) +
  geom_smooth(method = "lm", alpha = .2) + 
  facet_grid(~algorithm) + 
  scale_color_manual(name = "", values = instruction) + 
  scale_fill_manual(name = "", values = instruction) + 
  labs(x = "\npattern expression value", y = "reaction time (seconds)\n") + 
  dc_bw

by wave

data %>%
  filter(!is.na(rating)) %>%
  ggplot(aes(dotProduct, rt, color = wave, fill = wave)) +
  geom_smooth(aes(group = interaction(subjectID, instruction, wave)), method = "lm", se = FALSE, size = .1) +
  geom_smooth(method = "lm", alpha = .2) + 
  facet_grid(instruction~algorithm) + 
  scale_color_manual(name = "", values = algorithm) + 
  scale_fill_manual(name = "", values = algorithm) + 
  labs(x = "\npattern expression value", y = "reaction time (seconds)\n") + 
  dc_bw

MLM

Disaggregate within and between person relationships

  • dot_between = grand mean centered person average signature expression
  • dot_within = person-centered signature expression
between = data %>%
  group_by(wave, subjectID, algorithm) %>%
  summarize(dot_between = mean(dotProduct, na.rm = TRUE)) %>%
  ungroup() %>%
  mutate(dot_between = scale(dot_between, center = TRUE, scale = TRUE))

data_diss = data %>%
  group_by(wave, subjectID, algorithm) %>%
  mutate(dot_within = scale(dotProduct, center = TRUE, scale = TRUE)) %>%
  left_join(., between) %>%
  select(subjectID, wave, trial, instruction, rating, algorithm, dotProduct, dot_within, dot_between)

data_diss_regulation = data_diss %>%
  filter(algorithm == "craving_regulation")

data_diss_craving = data_diss %>%
  filter(algorithm == "craving")

data_diss_craving_koban = data_diss %>%
  filter(algorithm == "nsc_koban")

no brain

craving ~ wave x instruction

the intervention decreased cravings; this effect is slightly weaker when regulating

tidytable

mod_insruction = lmer(rating ~ instruction * wave + (1 + instruction * wave | subjectID),
                  data = data_diss_craving,
                  control = lmerControl(optimizer = "bobyqa"))
table_model(mod_insruction)
term b [95% CI] df t p
(Intercept) 3.27 [3.21, 3.33] 252.93 105.68 < .001
instruction (regulate) -0.94 [-1.01, -0.86] 251.63 -25.92 < .001
wave (post) -0.59 [-0.68, -0.51] 210.73 -13.72 < .001
instruction (regulate) x wave (post) 0.10 [0.03, 0.18] 218.23 2.70 .010

plot

ggeffects::ggpredict(mod_insruction, terms = c("wave", "instruction")) %>%
  data.frame() %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  geom_line(aes(group = group)) +
  scale_color_manual(name = "", values = instruction) + 
  scale_fill_manual(name = "", values = instruction) + 
  labs(x = "\nwave", y = "predicted bid value\n") + 
  dc_bw

model summary

summary(mod_insruction)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rating ~ instruction * wave + (1 + instruction * wave | subjectID)
##    Data: data_diss_craving
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 37746.3
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.9322 -0.6647  0.0183  0.6678  4.0244 
## 
## Random effects:
##  Groups    Name                      Variance Std.Dev. Corr             
##  subjectID (Intercept)               0.2131   0.4616                    
##            instructionregulate       0.2783   0.5276   -0.45            
##            wave2                     0.3367   0.5802   -0.17  0.00      
##            instructionregulate:wave2 0.1964   0.4432   -0.09 -0.31 -0.62
##  Residual                            0.4500   0.6708                    
## Number of obs: 17490, groups:  subjectID, 263
## 
## Fixed effects:
##                            Estimate Std. Error        df t value
## (Intercept)                 3.26627    0.03091 252.93493 105.684
## instructionregulate        -0.93565    0.03610 251.63019 -25.918
## wave2                      -0.59311    0.04322 210.72697 -13.724
## instructionregulate:wave2   0.10125    0.03748 218.23422   2.701
##                                       Pr(>|t|)    
## (Intercept)               < 0.0000000000000002 ***
## instructionregulate       < 0.0000000000000002 ***
## wave2                     < 0.0000000000000002 ***
## instructionregulate:wave2              0.00745 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) instrc wave2 
## instrctnrgl -0.480              
## wave2       -0.242  0.075       
## instrctnr:2  0.043 -0.384 -0.630

craving

brain ~ instruction x wave

expression is weaker when regulating

the intervention decreased expression

tidytable

mod_instruction = lmer(dotProduct ~ instruction * wave + (1 + instruction * wave | subjectID),
                  data = data_diss_craving,
                  control = lmerControl(optimizer = "bobyqa"))
table_model(mod_instruction)
term b [95% CI] df t p
(Intercept) 2.46 [1.95, 2.97] 254.80 9.48 < .001
instruction (regulate) -1.32 [-1.80, -0.83] 248.02 -5.32 < .001
wave (post) -0.53 [-1.12, 0.06] 228.84 -1.75 .080
instruction (regulate) x wave (post) -0.06 [-0.70, 0.57] 233.63 -0.19 .850

plot

ggeffects::ggpredict(mod_instruction, terms = c("wave", "instruction")) %>%
  data.frame() %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  geom_line(aes(group = group)) +
  scale_color_manual(name = "", values = instruction) + 
  scale_fill_manual(name = "", values = instruction) + 
  labs(x = "\nwave", y = "predicted pattern expression value\n") + 
  dc_bw

model summary

summary(mod_instruction)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: dotProduct ~ instruction * wave + (1 + instruction * wave | subjectID)
##    Data: data_diss_craving
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 134857
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -6.9698 -0.6021  0.0080  0.5954  9.6941 
## 
## Random effects:
##  Groups    Name                      Variance Std.Dev. Corr             
##  subjectID (Intercept)               12.042   3.470                     
##            instructionregulate        5.409   2.326     0.10            
##            wave2                      9.783   3.128    -0.45  0.03      
##            instructionregulate:wave2  3.415   1.848     0.32 -0.23 -0.71
##  Residual                            96.525   9.825                     
## Number of obs: 18079, groups:  subjectID, 265
## 
## Fixed effects:
##                            Estimate Std. Error        df t value
## (Intercept)                 2.45804    0.25915 254.80444   9.485
## instructionregulate        -1.31528    0.24732 248.01525  -5.318
## wave2                      -0.52628    0.29990 228.84184  -1.755
## instructionregulate:wave2  -0.06154    0.32298 233.63326  -0.191
##                                       Pr(>|t|)    
## (Intercept)               < 0.0000000000000002 ***
## instructionregulate                0.000000234 ***
## wave2                                   0.0806 .  
## instructionregulate:wave2               0.8491    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) instrc wave2 
## instrctnrgl -0.267              
## wave2       -0.520  0.282       
## instrctnr:2  0.333 -0.558 -0.638

craving ~ brain x wave

between-person: people who on average have higher expression, tend to report higher cravings

within-person: trials with higher than average expression are associated with higher craving ratings

tidy table

mod_craving = lmer(rating ~ dot_between * wave + dot_within * wave + (1 + dot_within * wave | subjectID),
               data = data_diss_craving,
               control = lmerControl(optimizer = "bobyqa"))
table_model(mod_craving)
term b [95% CI] df t p
(Intercept) 2.79 [2.74, 2.85] 249.58 99.72 < .001
between 0.02 [-0.02, 0.06] 257.76 0.82 .410
wave (post) -0.53 [-0.60, -0.46] 216.83 -15.23 < .001
within 0.07 [0.04, 0.09] 238.10 6.28 < .001
between x wave (post) 0.03 [-0.03, 0.09] 245.23 0.83 .410
wave (post) x within 0.02 [-0.00, 0.05] 230.01 1.69 .090

plot

by wave

vals = seq(-6, 6, .2)
ggeffects::ggpredict(mod_craving, terms = c("dot_between[vals]", "wave")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_craving, terms = c("dot_within[vals]", "wave")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .5, color = NA) +
  geom_line(aes(group = group)) +
  facet_grid(~type) +
  scale_color_manual(name = "wave", values = algorithm) + 
  scale_fill_manual(name = "wave", values = algorithm) + 
  labs(x = "\npredicted pattern expression value", y = "predicted craving rating\n") + 
  dc_bw

by expression

ggeffects::ggpredict(mod_craving, terms = c("wave", "dot_between [-1, 0, 1]")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_craving, terms = c("wave", "dot_within [-1, 0, 1]")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  geom_line(aes(group = group)) +
  facet_grid(~type) +
  scale_color_manual(name = "expression", values = algorithm) + 
  scale_fill_manual(name = "expression", values = algorithm) + 
  labs(x = "\nwave", y = "predicted craving rating\n") + 
  dc_bw

model summary

summary(mod_craving)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rating ~ dot_between * wave + dot_within * wave + (1 + dot_within *  
##     wave | subjectID)
##    Data: data_diss_craving
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 44518.4
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -3.12926 -0.72806 -0.04803  0.73580  3.02315 
## 
## Random effects:
##  Groups    Name             Variance Std.Dev. Corr             
##  subjectID (Intercept)      0.173807 0.41690                   
##            dot_within       0.006249 0.07905  -0.27            
##            wave2            0.214557 0.46320  -0.37  0.13      
##            dot_within:wave2 0.006546 0.08091   0.30 -0.17 -0.01
##  Residual                   0.727419 0.85289                   
## Number of obs: 17175, groups:  subjectID, 263
## 
## Fixed effects:
##                    Estimate Std. Error        df t value             Pr(>|t|)
## (Intercept)         2.79483    0.02803 249.58231  99.721 < 0.0000000000000002
## dot_between         0.01762    0.02143 257.75721   0.822               0.4116
## wave2              -0.53202    0.03494 216.82767 -15.227 < 0.0000000000000002
## dot_within          0.06516    0.01038 238.10318   6.280        0.00000000159
## dot_between:wave2   0.02531    0.03056 245.23341   0.828               0.4083
## wave2:dot_within    0.02458    0.01456 230.00543   1.688               0.0928
##                      
## (Intercept)       ***
## dot_between          
## wave2             ***
## dot_within        ***
## dot_between:wave2    
## wave2:dot_within  .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) dt_btw wave2  dt_wth dt_b:2
## dot_between -0.093                            
## wave2       -0.413  0.083                     
## dot_within  -0.126  0.000  0.057              
## dt_btwn:wv2  0.039 -0.469 -0.010  0.000       
## wv2:dt_wthn  0.099  0.000  0.000 -0.581 -0.001

craving ~ brain x instruction x wave

no 3-way interactions

tidy table

mod_rating_craving = lmer(rating ~ dot_between*instruction*wave + dot_within*instruction*wave +
                            (1 + dot_within * instruction + instruction * wave | subjectID),
                      data = data_diss_craving,
                      control = lmerControl(optimizer = "bobyqa"))
table_model(mod_rating_craving)
term b [95% CI] df t p
(Intercept) 3.26 [3.20, 3.32] 251.87 104.69 < .001
between 0.04 [-0.00, 0.09] 255.85 1.85 .070
instruction (regulate) -0.93 [-1.00, -0.86] 250.51 -25.69 < .001
wave (post) -0.59 [-0.67, -0.50] 211.75 -13.61 < .001
within 0.01 [-0.01, 0.03] 616.87 1.08 .280
between x instruction (regulate) -0.04 [-0.09, 0.02] 273.70 -1.35 .180
between x wave (post) 0.03 [-0.05, 0.10] 228.52 0.70 .480
instruction (regulate) x wave (post) 0.10 [0.02, 0.17] 221.02 2.58 .010
instruction (regulate) x within 0.03 [0.00, 0.06] 723.10 1.99 .050
wave (post) x within 0.02 [-0.01, 0.05] 9911.42 1.45 .150
between x instruction (regulate) x wave (post) -0.01 [-0.07, 0.06] 241.97 -0.29 .770
instruction (regulate) x wave (post) x within -0.01 [-0.05, 0.04] 12360.44 -0.33 .740

plot

by wave

vals = seq(-6, 6, .2)
ggeffects::ggpredict(mod_rating_craving, terms = c("dot_between[vals]", "wave", "instruction")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_rating_craving, terms = c("dot_within[vals]", "wave", "instruction")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .5, color = NA) +
  geom_line(aes(group = group)) +
  facet_grid(type~facet) +
  scale_color_manual(name = "wave", values = algorithm) + 
  scale_fill_manual(name = "wave", values = algorithm) + 
  labs(x = "\npattern expression value", y = "predicted craving rating\n") + 
  dc_bw

by expression

ggeffects::ggpredict(mod_rating_craving, terms = c("wave", "dot_between [-1, 0, 1]", "instruction")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_rating_craving, terms = c("wave", "dot_within [-1, 0, 1]", "instruction")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  geom_line(aes(group = group)) +
  facet_grid(type~facet) +
  scale_color_manual(name = "expression", values = algorithm) + 
  scale_fill_manual(name = "expression", values = algorithm) + 
  labs(x = "\nwave", y = "predicted bid value\n") + 
  dc_bw

model summary

summary(mod_rating_craving)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: 
## rating ~ dot_between * instruction * wave + dot_within * instruction *  
##     wave + (1 + dot_within * instruction + instruction * wave |      subjectID)
##    Data: data_diss_craving
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 37078.7
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.9635 -0.6614  0.0178  0.6614  4.0454 
## 
## Random effects:
##  Groups    Name                           Variance Std.Dev. Corr             
##  subjectID (Intercept)                    0.214700 0.46336                   
##            dot_within                     0.003767 0.06138  -0.31            
##            instructionregulate            0.276739 0.52606  -0.44 -0.03      
##            wave2                          0.329620 0.57413  -0.17  0.03 -0.01
##            dot_within:instructionregulate 0.004945 0.07032   0.19 -0.83  0.13
##            instructionregulate:wave2      0.195041 0.44163  -0.08  0.07 -0.31
##  Residual                                 0.446465 0.66818                   
##             
##             
##             
##             
##             
##  -0.12      
##  -0.60  0.11
##             
## Number of obs: 17175, groups:  subjectID, 263
## 
## Fixed effects:
##                                           Estimate   Std. Error           df
## (Intercept)                               3.261554     0.031155   251.872662
## dot_between                               0.043257     0.023396   255.854354
## instructionregulate                      -0.930597     0.036219   250.507886
## wave2                                    -0.585526     0.043021   211.747347
## dot_within                                0.011973     0.011054   616.871130
## dot_between:instructionregulate          -0.035193     0.026138   273.698588
## dot_between:wave2                         0.026483     0.037622   228.524922
## instructionregulate:wave2                 0.097307     0.037739   221.020985
## instructionregulate:dot_within            0.030408     0.015245   723.102116
## wave2:dot_within                          0.022246     0.015322  9911.424609
## dot_between:instructionregulate:wave2    -0.009511     0.032929   241.971245
## instructionregulate:wave2:dot_within     -0.007073     0.021471 12360.444450
##                                       t value            Pr(>|t|)    
## (Intercept)                           104.689 <0.0000000000000002 ***
## dot_between                             1.849              0.0656 .  
## instructionregulate                   -25.693 <0.0000000000000002 ***
## wave2                                 -13.610 <0.0000000000000002 ***
## dot_within                              1.083              0.2792    
## dot_between:instructionregulate        -1.346              0.1793    
## dot_between:wave2                       0.704              0.4822    
## instructionregulate:wave2               2.578              0.0106 *  
## instructionregulate:dot_within          1.995              0.0465 *  
## wave2:dot_within                        1.452              0.1466    
## dot_between:instructionregulate:wave2  -0.289              0.7730    
## instructionregulate:wave2:dot_within   -0.329              0.7418    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) dt_btw instrc wave2  dt_wth dt_bt: dt_b:2 inst:2 inst:_
## dot_between -0.088                                                        
## instrctnrgl -0.473  0.037                                                 
## wave2       -0.251  0.074  0.075                                          
## dot_within  -0.128  0.015  0.012  0.034                                   
## dt_btwn:nst  0.039 -0.455 -0.090 -0.034 -0.012                            
## dt_btwn:wv2  0.024 -0.350 -0.006  0.008 -0.012  0.135                     
## instrctnr:2  0.056 -0.045 -0.395 -0.619 -0.007  0.098 -0.011              
## instrctnr:_  0.071 -0.010  0.031 -0.046 -0.722 -0.001  0.009  0.026       
## wv2:dt_wthn  0.023 -0.015 -0.016 -0.037 -0.637  0.014  0.016  0.035  0.463
## dt_btwn:n:2 -0.006  0.141  0.035 -0.014  0.013 -0.476 -0.621 -0.013  0.000
## instrct:2:_ -0.016  0.010  0.002  0.022  0.456  0.002 -0.011  0.005 -0.652
##             wv2:d_ dt_::2
## dot_between              
## instrctnrgl              
## wave2                    
## dot_within               
## dt_btwn:nst              
## dt_btwn:wv2              
## instrctnr:2              
## instrctnr:_              
## wv2:dt_wthn              
## dt_btwn:n:2 -0.019       
## instrct:2:_ -0.716 -0.002

Koban craving

brain ~ instruction x wave

expression is weaker when regulating

the intervention decreased expression when looking, but not when regulating

tidytable

mod_instruction = lmer(dotProduct ~ instruction * wave + (1 + instruction * wave | subjectID),
                  data = data_diss_craving_koban,
                  control = lmerControl(optimizer = "bobyqa"))
table_model(mod_instruction)
term b [95% CI] df t p
(Intercept) 1.49 [1.18, 1.80] 260.42 9.42 < .001
instruction (regulate) -1.30 [-1.57, -1.04] 241.09 -9.61 < .001
wave (post) -0.38 [-0.71, -0.05] 217.95 -2.28 .020
instruction (regulate) x wave (post) 0.32 [-0.09, 0.73] 232.63 1.56 .120

plot

ggeffects::ggpredict(mod_instruction, terms = c("wave", "instruction")) %>%
  data.frame() %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  geom_line(aes(group = group)) +
  scale_color_manual(name = "", values = instruction) + 
  scale_fill_manual(name = "", values = instruction) + 
  labs(x = "\nwave", y = "predicted pattern expression value\n") + 
  dc_bw

model summary

summary(mod_instruction)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: dotProduct ~ instruction * wave + (1 + instruction * wave | subjectID)
##    Data: data_diss_craving_koban
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 117473.8
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -12.6833  -0.5967  -0.0068   0.6006   5.1906 
## 
## Random effects:
##  Groups    Name                      Variance Std.Dev. Corr             
##  subjectID (Intercept)                4.451   2.1098                    
##            instructionregulate        0.783   0.8849   -0.41            
##            wave2                      2.023   1.4223   -0.12 -0.12      
##            instructionregulate:wave2  1.971   1.4041   -0.13  0.09 -0.49
##  Residual                            37.138   6.0941                    
## Number of obs: 18079, groups:  subjectID, 265
## 
## Fixed effects:
##                           Estimate Std. Error       df t value
## (Intercept)                 1.4890     0.1580 260.4226   9.423
## instructionregulate        -1.3038     0.1357 241.0904  -9.608
## wave2                      -0.3795     0.1662 217.9524  -2.283
## instructionregulate:wave2   0.3236     0.2079 232.6302   1.556
##                                      Pr(>|t|)    
## (Intercept)               <0.0000000000000002 ***
## instructionregulate       <0.0000000000000002 ***
## wave2                                  0.0234 *  
## instructionregulate:wave2              0.1210    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) instrc wave2 
## instrctnrgl -0.494              
## wave2       -0.366  0.320       
## instrctnr:2  0.191 -0.534 -0.633

craving ~ brain x wave

between-person: average expression isn’t associated with craving ratings

within-person: trials with higher than average expression are associated with higher craving ratings

people with higher than average expression show weaker intervention effects (i.e., smaller decreases)

tidy table

mod_craving = lmer(rating ~ dot_between * wave + dot_within * wave + (1 + dot_within * wave | subjectID),
               data = data_diss_craving_koban,
               control = lmerControl(optimizer = "bobyqa"))
table_model(mod_craving)
term b [95% CI] df t p
(Intercept) 2.81 [2.75, 2.86] 250.73 98.55 < .001
between 0.04 [-0.04, 0.12] 257.63 1.04 .300
wave (post) -0.52 [-0.59, -0.45] 214.33 -14.54 < .001
within 0.13 [0.11, 0.16] 244.58 12.30 < .001
between x wave (post) 0.06 [-0.04, 0.17] 246.71 1.16 .250
wave (post) x within -0.02 [-0.05, 0.01] 241.20 -1.12 .260

plot

by wave

vals = seq(-6, 6, .2)
ggeffects::ggpredict(mod_craving, terms = c("dot_between[vals]", "wave")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_craving, terms = c("dot_within[vals]", "wave")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .5, color = NA) +
  geom_line(aes(group = group)) +
  facet_grid(~type) +
  scale_color_manual(name = "wave", values = algorithm) + 
  scale_fill_manual(name = "wave", values = algorithm) + 
  labs(x = "\npredicted pattern expression value", y = "predicted craving rating\n") + 
  dc_bw

by expression

ggeffects::ggpredict(mod_craving, terms = c("wave", "dot_between [-1, 0, 1]")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_craving, terms = c("wave", "dot_within [-1, 0, 1]")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  geom_line(aes(group = group)) +
  facet_grid(~type) +
  scale_color_manual(name = "expression", values = algorithm) + 
  scale_fill_manual(name = "expression", values = algorithm) + 
  labs(x = "\nwave", y = "predicted craving rating\n") + 
  dc_bw

model summary

summary(mod_craving)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rating ~ dot_between * wave + dot_within * wave + (1 + dot_within *  
##     wave | subjectID)
##    Data: data_diss_craving_koban
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 44262.5
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -3.13447 -0.72412 -0.04339  0.75127  3.03730 
## 
## Random effects:
##  Groups    Name             Variance Std.Dev. Corr             
##  subjectID (Intercept)      0.173391 0.41640                   
##            dot_within       0.009548 0.09771  -0.19            
##            wave2            0.214132 0.46274  -0.38  0.05      
##            dot_within:wave2 0.011684 0.10809   0.22 -0.56  0.34
##  Residual                   0.715996 0.84617                   
## Number of obs: 17175, groups:  subjectID, 263
## 
## Fixed effects:
##                    Estimate Std. Error        df t value            Pr(>|t|)
## (Intercept)         2.80515    0.02846 250.72597  98.551 <0.0000000000000002
## dot_between         0.04214    0.04055 257.62504   1.039               0.300
## wave2              -0.52258    0.03593 214.32542 -14.544 <0.0000000000000002
## dot_within          0.13455    0.01094 244.57931  12.298 <0.0000000000000002
## dot_between:wave2   0.06151    0.05299 246.71100   1.161               0.247
## wave2:dot_within   -0.01693    0.01511 241.20142  -1.120               0.264
##                      
## (Intercept)       ***
## dot_between          
## wave2             ***
## dot_within        ***
## dot_between:wave2    
## wave2:dot_within     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) dt_btw wave2  dt_wth dt_b:2
## dot_between  0.207                            
## wave2       -0.406 -0.080                     
## dot_within  -0.098  0.000  0.023              
## dt_btwn:wv2 -0.110 -0.539  0.250  0.000       
## wv2:dt_wthn  0.090  0.001  0.151 -0.640  0.002

craving ~ brain x instruction x wave

no 3-way interactions

tidy table

mod_rating_craving = lmer(rating ~ dot_between*instruction*wave + dot_within*instruction*wave +
                            (1 + dot_within * instruction + instruction * wave | subjectID),
                      data = data_diss_craving_koban,
                      control = lmerControl(optimizer = "bobyqa"))
table_model(mod_rating_craving)
term b [95% CI] df t p
(Intercept) 3.27 [3.20, 3.33] 251.99 103.58 < .001
between 0.06 [-0.02, 0.15] 256.59 1.45 .150
instruction (regulate) -0.93 [-1.00, -0.86] 253.18 -25.38 < .001
wave (post) -0.57 [-0.65, -0.48] 208.98 -12.79 < .001
within 0.10 [0.08, 0.12] 618.96 9.40 < .001
between x instruction (regulate) -0.05 [-0.14, 0.05] 278.01 -0.95 .340
between x wave (post) 0.08 [-0.05, 0.21] 225.30 1.25 .210
instruction (regulate) x wave (post) 0.09 [0.01, 0.17] 215.32 2.31 .020
instruction (regulate) x within -0.06 [-0.09, -0.03] 780.66 -3.73 < .001
wave (post) x within -0.00 [-0.03, 0.03] 10466.53 -0.16 .880
between x instruction (regulate) x wave (post) -0.01 [-0.13, 0.10] 245.92 -0.24 .810
instruction (regulate) x wave (post) x within 0.01 [-0.04, 0.05] 12825.25 0.31 .760

plot

by wave

vals = seq(-6, 6, .2)
ggeffects::ggpredict(mod_rating_craving, terms = c("dot_between[vals]", "wave", "instruction")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_rating_craving, terms = c("dot_within[vals]", "wave", "instruction")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .5, color = NA) +
  geom_line(aes(group = group)) +
  facet_grid(type~facet) +
  scale_color_manual(name = "wave", values = algorithm) + 
  scale_fill_manual(name = "wave", values = algorithm) + 
  labs(x = "\npattern expression value", y = "predicted craving rating\n") + 
  dc_bw

by expression

ggeffects::ggpredict(mod_rating_craving, terms = c("wave", "dot_between [-1, 0, 1]", "instruction")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_rating_craving, terms = c("wave", "dot_within [-1, 0, 1]", "instruction")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  geom_line(aes(group = group)) +
  facet_grid(type~facet) +
  scale_color_manual(name = "expression", values = algorithm) + 
  scale_fill_manual(name = "expression", values = algorithm) + 
  labs(x = "\nwave", y = "predicted bid value\n") + 
  dc_bw

model summary

summary(mod_rating_craving)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: 
## rating ~ dot_between * instruction * wave + dot_within * instruction *  
##     wave + (1 + dot_within * instruction + instruction * wave |      subjectID)
##    Data: data_diss_craving_koban
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 36912.3
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.9512 -0.6564  0.0162  0.6569  4.0092 
## 
## Random effects:
##  Groups    Name                           Variance Std.Dev. Corr             
##  subjectID (Intercept)                    0.212731 0.46123                   
##            dot_within                     0.002975 0.05454  -0.12            
##            instructionregulate            0.273611 0.52308  -0.44 -0.01      
##            wave2                          0.327295 0.57210  -0.17  0.11  0.00
##            dot_within:instructionregulate 0.003211 0.05666   0.19 -0.67 -0.10
##            instructionregulate:wave2      0.197395 0.44429  -0.09 -0.18 -0.31
##  Residual                                 0.442159 0.66495                   
##             
##             
##             
##             
##             
##   0.15      
##  -0.61  0.07
##             
## Number of obs: 17175, groups:  subjectID, 263
## 
## Fixed effects:
##                                           Estimate   Std. Error           df
## (Intercept)                               3.266276     0.031534   251.994314
## dot_between                               0.064016     0.044236   256.592044
## instructionregulate                      -0.928494     0.036578   253.178468
## wave2                                    -0.566867     0.044333   208.976082
## dot_within                                0.099925     0.010628   618.958725
## dot_between:instructionregulate          -0.047182     0.049432   278.006417
## dot_between:wave2                         0.081566     0.065326   225.302439
## instructionregulate:wave2                 0.089826     0.038895   215.316155
## instructionregulate:dot_within           -0.055787     0.014947   780.656299
## wave2:dot_within                         -0.002312     0.014859 10466.525932
## dot_between:instructionregulate:wave2    -0.014099     0.058728   245.920318
## instructionregulate:wave2:dot_within      0.006578     0.021298 12825.253156
##                                       t value             Pr(>|t|)    
## (Intercept)                           103.579 < 0.0000000000000002 ***
## dot_between                             1.447             0.149079    
## instructionregulate                   -25.384 < 0.0000000000000002 ***
## wave2                                 -12.787 < 0.0000000000000002 ***
## dot_within                              9.402 < 0.0000000000000002 ***
## dot_between:instructionregulate        -0.954             0.340674    
## dot_between:wave2                       1.249             0.213104    
## instructionregulate:wave2               2.309             0.021866 *  
## instructionregulate:dot_within         -3.732             0.000203 ***
## wave2:dot_within                       -0.156             0.876351    
## dot_between:instructionregulate:wave2  -0.240             0.810475    
## instructionregulate:wave2:dot_within    0.309             0.757441    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) dt_btw instrc wave2  dt_wth dt_bt: dt_b:2 inst:2 inst:_
## dot_between  0.200                                                        
## instrctnrgl -0.469 -0.084                                                 
## wave2       -0.236 -0.040  0.073                                          
## dot_within  -0.072 -0.003  0.028  0.057                                   
## dt_btwn:nst -0.087 -0.446  0.192  0.008  0.003                            
## dt_btwn:wv2 -0.077 -0.398  0.028  0.260  0.002  0.157                     
## instrctnr:2  0.038 -0.005 -0.380 -0.625 -0.073 -0.063 -0.159              
## instrctnr:_  0.065  0.003 -0.019  0.009 -0.690  0.000 -0.002  0.012       
## wv2:dt_wthn  0.027  0.002 -0.023 -0.034 -0.643 -0.004 -0.005  0.034  0.458
## dt_btwn:n:2  0.027  0.152 -0.100 -0.159 -0.003 -0.534 -0.600  0.244 -0.001
## instrct:2:_ -0.018 -0.002 -0.001  0.031  0.450  0.000  0.004  0.001 -0.663
##             wv2:d_ dt_::2
## dot_between              
## instrctnrgl              
## wave2                    
## dot_within               
## dt_btwn:nst              
## dt_btwn:wv2              
## instrctnr:2              
## instrctnr:_              
## wv2:dt_wthn              
## dt_btwn:n:2  0.006       
## instrct:2:_ -0.698  0.002

craving regulation

brain ~ instruction x wave

expression is stronger when regulating

the intervention increased expression when looking and decreased expression when regulating

tidytable

mod_instruction = lmer(dotProduct ~ instruction * wave + (1 + instruction * wave | subjectID),
                  data = data_diss_regulation,
                  control = lmerControl(optimizer = "bobyqa"))
table_model(mod_instruction)
term b [95% CI] df t p
(Intercept) -2.59 [-3.00, -2.17] 255.97 -12.17 < .001
instruction (regulate) 8.50 [7.96, 9.04] 250.30 30.90 < .001
wave (post) 0.75 [0.29, 1.22] 229.53 3.18 < .001
instruction (regulate) x wave (post) -1.16 [-1.76, -0.57] 220.23 -3.86 < .001

plot

ggeffects::ggpredict(mod_instruction, terms = c("wave", "instruction")) %>%
  data.frame() %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  geom_line(aes(group = group)) +
  scale_color_manual(name = "", values = instruction) + 
  scale_fill_manual(name = "", values = instruction) + 
  labs(x = "\nwave", y = "predicted pattern expression value\n") + 
  dc_bw

model summary

summary(mod_instruction)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: dotProduct ~ instruction * wave + (1 + instruction * wave | subjectID)
##    Data: data_diss_regulation
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 127494.5
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -6.2752 -0.6117  0.0019  0.6162  5.6498 
## 
## Random effects:
##  Groups    Name                      Variance Std.Dev. Corr             
##  subjectID (Intercept)                8.131   2.851                     
##            instructionregulate       12.610   3.551    -0.15            
##            wave2                      5.599   2.366    -0.38  0.17      
##            instructionregulate:wave2  6.575   2.564     0.04 -0.35 -0.37
##  Residual                            63.280   7.955                     
## Number of obs: 18079, groups:  subjectID, 265
## 
## Fixed effects:
##                           Estimate Std. Error       df t value
## (Intercept)                -2.5851     0.2125 255.9745 -12.168
## instructionregulate         8.4983     0.2750 250.3038  30.900
## wave2                       0.7541     0.2371 229.5291   3.180
## instructionregulate:wave2  -1.1643     0.3019 220.2288  -3.857
##                                       Pr(>|t|)    
## (Intercept)               < 0.0000000000000002 ***
## instructionregulate       < 0.0000000000000002 ***
## wave2                                 0.001674 ** 
## instructionregulate:wave2             0.000151 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) instrc wave2 
## instrctnrgl -0.332              
## wave2       -0.485  0.291       
## instrctnr:2  0.232 -0.488 -0.555

craving ~ brain x wave

between-person: average expression isn’t related to craving ratings

within-person: trials with higher than average expression are associated with lower craving ratings

tidy table

mod_craving = lmer(rating ~ dot_between * wave + dot_within * wave + (1 + dot_within * wave | subjectID),
               data = data_diss_regulation,
               control = lmerControl(optimizer = "bobyqa"))
table_model(mod_craving)
term b [95% CI] df t p
(Intercept) 2.80 [2.74, 2.85] 248.90 100.80 < .001
between 0.01 [-0.04, 0.06] 251.37 0.47 .640
wave (post) -0.53 [-0.60, -0.46] 214.45 -15.01 < .001
within -0.25 [-0.27, -0.22] 249.42 -19.47 < .001
between x wave (post) -0.06 [-0.13, 0.00] 241.29 -1.86 .060
wave (post) x within 0.03 [-0.00, 0.06] 225.48 1.96 .050

plot

by wave

vals = seq(-6, 6, .2)
ggeffects::ggpredict(mod_craving, terms = c("dot_between[vals]", "wave")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_craving, terms = c("dot_within[vals]", "wave")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .5, color = NA) +
  geom_line(aes(group = group)) +
  facet_grid(~type) +
  scale_color_manual(name = "wave", values = algorithm) + 
  scale_fill_manual(name = "wave", values = algorithm) + 
  labs(x = "\npredicted pattern expression value", y = "predicted craving rating\n") + 
  dc_bw

by expression

ggeffects::ggpredict(mod_craving, terms = c("wave", "dot_between [-1, 0, 1]")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_craving, terms = c("wave", "dot_within [-1, 0, 1]")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  geom_line(aes(group = group)) +
  facet_grid(~type) +
  scale_color_manual(name = "expression", values = algorithm) + 
  scale_fill_manual(name = "expression", values = algorithm) + 
  labs(x = "\nwave", y = "predicted craving rating\n") + 
  dc_bw

model summary

summary(mod_craving)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rating ~ dot_between * wave + dot_within * wave + (1 + dot_within *  
##     wave | subjectID)
##    Data: data_diss_regulation
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 43037.4
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.3267 -0.6919 -0.0334  0.7086  3.1697 
## 
## Random effects:
##  Groups    Name             Variance Std.Dev. Corr             
##  subjectID (Intercept)      0.17210  0.4149                    
##            dot_within       0.02116  0.1455   -0.01            
##            wave2            0.21722  0.4661   -0.36 -0.10      
##            dot_within:wave2 0.01542  0.1242   -0.27 -0.09 -0.46
##  Residual                   0.65868  0.8116                    
## Number of obs: 17175, groups:  subjectID, 263
## 
## Fixed effects:
##                    Estimate Std. Error        df t value            Pr(>|t|)
## (Intercept)         2.79598    0.02774 248.90361 100.797 <0.0000000000000002
## dot_between         0.01188    0.02550 251.37467   0.466              0.6418
## wave2              -0.52827    0.03518 214.45366 -15.014 <0.0000000000000002
## dot_within         -0.24596    0.01263 249.41536 -19.469 <0.0000000000000002
## dot_between:wave2  -0.06300    0.03394 241.28877  -1.857              0.0646
## wave2:dot_within    0.03060    0.01564 225.47674   1.956              0.0517
##                      
## (Intercept)       ***
## dot_between          
## wave2             ***
## dot_within        ***
## dot_between:wave2 .  
## wave2:dot_within  .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) dt_btw wave2  dt_wth dt_b:2
## dot_between -0.083                            
## wave2       -0.393  0.046                     
## dot_within  -0.006  0.001 -0.055              
## dt_btwn:wv2  0.045 -0.534 -0.151  0.000       
## wv2:dt_wthn -0.118 -0.007 -0.248 -0.433  0.002

craving ~ brain x instruction x wave

no 3-way interactions

tidy table

mod_rating_craving = lmer(rating ~ dot_between*instruction*wave + dot_within*instruction*wave +
                            (1 + dot_within * instruction + instruction * wave | subjectID),
                      data = data_diss_regulation,
                      control = lmerControl(optimizer = "bobyqa"))
table_model(mod_rating_craving)
term b [95% CI] df t p
(Intercept) 3.25 [3.19, 3.31] 260.07 103.29 < .001
between 0.03 [-0.03, 0.08] 250.82 0.94 .350
instruction (regulate) -0.92 [-0.99, -0.84] 261.39 -24.79 < .001
wave (post) -0.59 [-0.68, -0.50] 219.84 -13.27 < .001
within -0.03 [-0.06, -0.01] 590.74 -2.58 .010
between x instruction (regulate) -0.03 [-0.09, 0.03] 270.93 -1.07 .290
between x wave (post) -0.07 [-0.16, 0.02] 224.10 -1.57 .120
instruction (regulate) x wave (post) 0.10 [0.02, 0.17] 253.70 2.46 .010
instruction (regulate) x within 0.03 [-0.01, 0.06] 716.53 1.57 .120
wave (post) x within -0.02 [-0.06, 0.01] 8557.95 -1.26 .210
between x instruction (regulate) x wave (post) 0.04 [-0.04, 0.11] 241.91 0.93 .350
instruction (regulate) x wave (post) x within 0.04 [-0.00, 0.09] 11658.26 1.80 .070

plot

by wave

vals = seq(-6, 6, .2)
ggeffects::ggpredict(mod_rating_craving, terms = c("dot_between[vals]", "wave", "instruction")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_rating_craving, terms = c("dot_within[vals]", "wave", "instruction")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .5, color = NA) +
  geom_line(aes(group = group)) +
  facet_grid(type~facet) +
  scale_color_manual(name = "wave", values = algorithm) + 
  scale_fill_manual(name = "wave", values = algorithm) + 
  labs(x = "\npattern expression value", y = "predicted craving rating\n") + 
  dc_bw

by expression

ggeffects::ggpredict(mod_rating_craving, terms = c("wave", "dot_between [-1, 0, 1]", "instruction")) %>%
  data.frame() %>%
  mutate(type = "between-person") %>%
  bind_rows(ggeffects::ggpredict(mod_rating_craving, terms = c("wave", "dot_within [-1, 0, 1]", "instruction")) %>%
              data.frame() %>%
              mutate(type = "within-person")) %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
  geom_line(aes(group = group)) +
  facet_grid(type~facet) +
  scale_color_manual(name = "expression", values = algorithm) + 
  scale_fill_manual(name = "expression", values = algorithm) + 
  labs(x = "\nwave", y = "predicted bid value\n") + 
  dc_bw

model summary

summary(mod_rating_craving)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: 
## rating ~ dot_between * instruction * wave + dot_within * instruction *  
##     wave + (1 + dot_within * instruction + instruction * wave |      subjectID)
##    Data: data_diss_regulation
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 37104.8
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.9151 -0.6696  0.0192  0.6654  4.0473 
## 
## Random effects:
##  Groups    Name                           Variance Std.Dev. Corr             
##  subjectID (Intercept)                    0.212127 0.46057                   
##            dot_within                     0.006012 0.07754   0.07            
##            instructionregulate            0.277867 0.52713  -0.43  0.03      
##            wave2                          0.333225 0.57726  -0.17  0.07  0.00
##            dot_within:instructionregulate 0.009336 0.09662  -0.18 -0.98 -0.02
##            instructionregulate:wave2      0.195280 0.44191  -0.11 -0.16 -0.31
##  Residual                                 0.447378 0.66886                   
##             
##             
##             
##             
##             
##  -0.17      
##  -0.61  0.34
##             
## Number of obs: 17175, groups:  subjectID, 263
## 
## Fixed effects:
##                                          Estimate  Std. Error          df
## (Intercept)                               3.24980     0.03146   260.06560
## dot_between                               0.02628     0.02799   250.81903
## instructionregulate                      -0.91709     0.03700   261.38706
## wave2                                    -0.58899     0.04440   219.83569
## dot_within                               -0.03337     0.01292   590.73639
## dot_between:instructionregulate          -0.03328     0.03112   270.92658
## dot_between:wave2                        -0.06897     0.04380   224.09837
## instructionregulate:wave2                 0.09700     0.03936   253.69774
## instructionregulate:dot_within            0.02768     0.01766   716.53149
## wave2:dot_within                         -0.02211     0.01758  8557.95142
## dot_between:instructionregulate:wave2     0.03565     0.03822   241.90730
## instructionregulate:wave2:dot_within      0.04357     0.02419 11658.26287
##                                       t value            Pr(>|t|)    
## (Intercept)                           103.288 <0.0000000000000002 ***
## dot_between                             0.939              0.3488    
## instructionregulate                   -24.789 <0.0000000000000002 ***
## wave2                                 -13.266 <0.0000000000000002 ***
## dot_within                             -2.583              0.0100 *  
## dot_between:instructionregulate        -1.070              0.2858    
## dot_between:wave2                      -1.575              0.1167    
## instructionregulate:wave2               2.464              0.0144 *  
## instructionregulate:dot_within          1.568              0.1174    
## wave2:dot_within                       -1.257              0.2087    
## dot_between:instructionregulate:wave2   0.933              0.3519    
## instructionregulate:wave2:dot_within    1.801              0.0717 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) dt_btw instrc wave2  dt_wth dt_bt: dt_b:2 inst:2 inst:_
## dot_between -0.077                                                        
## instrctnrgl -0.474  0.030                                                 
## wave2       -0.254  0.027  0.095                                          
## dot_within   0.185  0.021 -0.129 -0.095                                   
## dt_btwn:nst  0.033 -0.447 -0.068 -0.008 -0.018                            
## dt_btwn:wv2  0.025 -0.369 -0.008 -0.161 -0.017  0.140                     
## instrctnr:2  0.057 -0.006 -0.405 -0.630  0.088  0.030  0.099              
## instrctnr:_ -0.176 -0.012  0.002  0.041 -0.757  0.003  0.015  0.073       
## wv2:dt_wthn -0.120 -0.015  0.101  0.179 -0.635  0.013  0.022 -0.199  0.467
## dt_btwn:n:2 -0.006  0.140  0.031  0.101  0.019 -0.493 -0.617 -0.140 -0.008
## instrct:2:_  0.089  0.009 -0.006 -0.138  0.464 -0.002 -0.016  0.028 -0.647
##             wv2:d_ dt_::2
## dot_between              
## instrctnrgl              
## wave2                    
## dot_within               
## dt_btwn:nst              
## dt_btwn:wv2              
## instrctnr:2              
## instrctnr:_              
## wv2:dt_wthn              
## dt_btwn:n:2 -0.025       
## instrct:2:_ -0.733  0.004
## optimizer (bobyqa) convergence code: 1 (bobyqa -- maximum number of function evaluations exceeded)
## Model failed to converge with max|grad| = 0.0146957 (tol = 0.002, component 1)